home *** CD-ROM | disk | FTP | other *** search
Text File | 1991-09-12 | 56.6 KB | 1,169 lines | [TEXT/MPS ] |
- { Leaks:
- a dcmd to display potential memory leaks.
-
- Copyright © 1990-91 by Apple Computer, Inc., all rights reserved.
-
- by Bo3b Johnson 10/9/90
- MS 37-DS
-
- 5/23/91: Cleaned up comments a bit.
- Changed number of blocks to watch back to 500 to use less RAM.
- Bumped it to Version 5, as a new release.
-
- for best viewing, use Palatino 12.
- }
-
- UNIT Leaks;
-
- (*
- Build this dude using the Build Menu, it has a make file.
-
-
- This dcmd is a leak detector, intended to help you find memory leaks from programs
- that are orphaning handles or pointers in the heap. It is a non-deterministic problem
- to try to find leaks, so I do a funky thing: You have to run the operation you are
- checking 3 times. Then, this dcmd will look for 3 blocks of the same size, allocated
- from the same code, and will display a stack crawl for that purported leak. Needless
- to say, this is not bulletproof. The human running this command is expected to check
- things out further to see if it is a real leak or not.
-
- I do this weirdness by patching NewHandle/DisposHandle, NewPtr/DisposPtr.
- I watch pointers/handles going by when they are allocated and disposed, and save their
- addresses off in a b-tree inside a big-ass block in the system heap. I use a b-tree so the
- machine has no perceptible loss of speed even though I've patched several often used traps.
- When a DisposX goes by, I mark the address off my list, since it was validly disposed.
- When this dcmd comes in, it looks through the b-tree for entries still in it, and
- dumps out info about each element that is still in the tree; with the constraints that the
- block size has to be the same for three or more blocks, and they have to have the same
- stack crawl.
-
- One dangerous aspect of this code is that most of it is recursive. The reason of course is
- that I use a b-tree to track the information about each of the blocks I see go by. The use
- of a b-tree is the only way to do this because otherwise the system will slow down
- radically if this code were to use something lame like a linear list. This way, there is
- no appreciable hit on the speed of the computer, even if I am tracking several thousand
- blocks. This is hip. The problem of course is that b-trees lend themselves really, really
- nicely to recursive routines to drive the data structure. With Macsbug having a gutless
- 1K stack, this is of course fairly dangerous. I thus go out of my way to make sure that
- I pass the minimum number of parameters during a recursive operation. This is
- typically a 4 byte pointer to an element. It is not strictly a requirement that I have to
- do it recursively, it just makes the code smaller and easier to understand.
-
- One thing that isn't clear, is whether local strings, used for display, will burn up stack
- space. I think they don't but if they do, they could maybe be made global instead. It is
- also unclear whether globals subtract from stack space as well, or whether you get 1K
- of stack, regardless of the number of globals. I've mostly presumed that is true, that
- there is a fixed stack, after globals are allocated. With that in mind, I've minimized
- all the local variables used by the routines, as well as the parameters passed in. This
- has resulted in a number of globals, but there's always a tradeoff.
-
- Stack operations are alleviated a little bit since the dcmd can have global variables.
- This makes it possible to avoid having to pass in some parameters that are the same
- each time, at the expense of being less maintainable. This code is pretty small though,
- so it's worth it.
-
- Since this is a dcmd, I try to avoid using the toolbox as much as possible. This means
- avoiding things like StringtoNum, and UprCase, even though I could have used some
- of these things. Any use of the toolbox is probably bad, since I can't be sure the heap is in
- a consistent shape when dumping info. The exception to this, is that at startup I want
- to allocate a big block to store the records (elements) that save info about each block seen.
- After that first allocation, I avoid using the toolbox as much as possible. In fact, as far
- as I know at this point, I don't use any toolbox calls, except during the init of the dcmd,
- and when the tree is being dumped I use RsrcMapEntry to determine if some handle
- I've got is a resource or not. This won't allocate memory.
-
- Macsbug calls the dcmd at Init time, which is when Macsbug is loaded, early in boot.
- At that point, I create and save the buffer that is used to store the b-tree records that
- track each block allocated in the system. Since I have global variables, I use one of
- those to save off the address of the block created, so I can get back to it at will. This
- global is saved in the dcmd apparently, which is great, since it makes it possible to
- get back to the block without having to do something sick, like patch Chain which
- is what I was doing. A marked improvement.
-
- I'm using RsrcMapEntry to drive the resource map for me, trying to match an address
- to a possible resource. If the handle in question is a resource, then it cannot be a leak
- since the resource manager is still using the handle. This allows me to avoid a few
- false alarms, for blocks that are the same size, and stack crawl, allocated from the
- resource manager. This is also a danger zone in this code. I cannot guarantee that
- the routine won't get called at interrupt time, and if it is, then the rsrcmaphandle
- may not be correct when this guy tries to use it. How big a problem is this? It is
- something to note anyway.
-
- Another thing it should probably do is to watch for applications going away and mark
- all the blocks in their heap out of the list. Right now if you launch an app twice in a row
- with it turned on, you'll get a b-tree fried error, which is caused because a block with
- the same address is being added to the tree, and this should never happen for blocks
- that are actively in use. The b-tree check routine notices that blocks got added to the
- list, and will flag it. You only get the error message when the tree status is checked,
- which is any time it is invoked in Macsbug.
-
- The analysis routine is seriously way slow when it has a big tree to check, since it is
- an N-squared problem. It is likely that there is a more optimal way, but I wanted
- something sooner instead of later.
-
- Notably this is a sick thing. This whole dcmd is a heuristic way of finding memory
- leaks, and as such it may not work properly in all cases. I am very interested to know
- of cases where it fails, either by being too strict and reporting false leaks, and also where
- it might be filtering too much data, and not showing a leak when there actually is one.
- If you see any of these cases, let me know, and I'll try to fix it. The problem of course is
- that the Macintosh memory management is pretty funky and it is unlikely that there
- is a completely solid way of doing this type of function. Is this why it hasn't been done
- before? Probably. As an example of the problem, think about trying to differentiate
- between a persistent block (something allocated early on in an application, like CODE 1)
- and a genuine leak. The CODE 1 handle will be around for ever, but it is not a leak, since
- it is not multiplying. Now, how do you find a block that is allocated during an application's
- init time that actually is a leak, but only happens once? How can you tell the difference?
- Notably, I can't see that case here either (but don't really care, since it loses a chunk of
- memory that is wasted, but won't crash things long term).
- I believe the system runs in a very heuristic fashion, so the tools must do so as well.
- This tool should still be quite useful, even though it is not 100% solid. This is the
- often maligned 90% solution. I'm betting you'll like it better than the nonexistent
- 100% solution.
-
- I implement a memory based b-tree, to watch memory manager blocks.
- This is done in pascal so as to make it easier to maintain.
- The basic idea here is that this is the code to manage the big block in low memory
- as a set of records (TrackingTableEntry), where each entry is part of a b-tree. If a
- a record is not in use, it is in a linked list of empty records, starting with pEmptyQ
- as the pointer to the first one. The pTreeTop is a pointer to the first TrackingTableEntry,
- which is the head of a b-tree of these records. Each record keeps track of a single
- memory manager block in any heap in the system, via the address field. This code
- isolates the b-tree management stuff from the skanky assembly junk required to
- patch the traps effectively.
-
- Note that this isn't the most mondo b-tree code ever made. It is a very simple, easy
- to implement couple of routines, but I get the advantages of b-trees anyway. In
- particular, it is not a balanced tree, and makes no effort to do so. I presume that the
- addresses that are being watched (which are the sort keys), will be fairly random, so
- that the tree will not become seriously overbalanced. This is reasonable, but in some
- cases I see the tree become overbalanced, depending upon how memory is allocated.
- In any case, the tree never really gets more than about 10-15 levels deep which is still
- two orders of magnitude better than a linear search of the same 1000 or so blocks. Just
- don't scam this b-tree code assuming that it is rad. It isn't, but it works for something
- simple like this. Course you could ask, why is there simple b-tree code here, in this
- trivial tool, but not in the resource manager? Well, you may well ask. (one reason is
- that the resource manager allows random sized data, but I will still ask).
-
- Ughh. I added some dcmdDrawLines here, instead of DebugStr, in the rare case when
- the b-tree may get blown up. This check is done whenever it is turned on or off, just
- as a consistency check and to be sure the tree is still set up properly and not giving
- bogus info. This routine will thus run at dcmd time, and if you DebugStr there, it
- will blow away Macsbug giving a 'macsbug caused the exception' error. Sick. So I
- changed it to be dcmdDrawLines instead, even though I really want to keep these
- routines from having to know they are part of a dcmd. I'll think about it.
-
- A couple of things are apparent after using it for awhile. The b-tree is very unbalanced
- during some use, since the memory manager does a roving up allocation, so the addresses
- tend to be increasing as added, giving an unbalanced tree. This is OK, but turns the tree
- into a linear list instead. It actually isn't too bad, so it may not be worth changing, but
- it is worth noting. If you allocate a lot of blocks, it is possible to get into a bogus tree.
- This almost always happens during an application launch. For the system heap, memory
- tends to be pretty random, as I want it. If I'm tracking several hundred blocks in an
- app, it is likely the tree is not balanced, so it will be slower than desired. Most leak
- check operations are looking in the 10-50 block range, so it's no big deal.
-
- Something I found out about is that Macsbug Init time is before the system file has
- been used to patch the traps to fix bugs in the ROM. That means that any trap patches
- I make here are fine, including tail patches. Tail patches are OK at this point because
- the system hasn't been patched yet, so we won't disable any bug fixes. Yeah.
- With TMon Pro loading at Init time instead, this is still a problem, so think about it.
-
- This also causes a fair number of stack overflows in Macsbug. This doesn't cause any
- crashes, but will trash Macsbug's copy of the screen, so you end up with smashed bits
- on the screen, after leaks does it's analysis. I need to figure out some way to minimize
- the stack usage during searching, since the tiny Macsbug stack is obviously insufficient.
-
- The options are: Leaks [On|Off|Dump]
- If you just do Leaks by itself, it will dump the potential leaks in the tree as it exists at that
- point, without changing the on/off state. This may be helpful for in between tests, but
- is mainly to allow you to get info without having to type the whole thing. This is
- essentially the same as Leaks Off, but it won't change the watching state.
- Leaks On will flush the b-tree to a known empty state, and turn the watcher on. Only
- the header will be displayed to show it went back to all empties.
- Leaks Off will turn the watching mechanism off, saving the tree in that known state. It
- will also do the dumping operation to display likely leaks, since that is probably what
- you want when you turn it off.
- Leaks Dump will dump the entire tree (all non-empty elements) so you can see what all
- blocks are being watched if that is helpful.
-
-
- Things to do:
- Is it too restrictive to force the blocks to match including the pc crawls? If a code block
- moved around a lot, the pc wouldn't necessarily match, there still would be a leak,
- but I wouldn't show it. ... (could do Code+offset)
- Use PatchLink stuff for 7.0. (or does it matter since I patch at Macsbug load time?)
- Probably can't patch link here, since it is too early.
- If you kill the app, I don't see those blocks get marked off.
- Later, hook into heap dieing.
- Setup something for the dcmd to use to allocate number of elements in heap? Some
- way to make it selectable?
- Selectable way to filter the number of blocks required for a match? Like not just 3 or more.
- Ideally, I want all the tree knowledge in a b-tree unit instead. Right now the tree stuff
- knows a little about the dcmd side, and the dcmd side knows how to drive the tree.
- One thing I sort of want to do is give the address line for every block that looks like a leak,
- so that you can see them all before the stack crawl. I don't want more than one stack
- crawl for a leak though. This would involve sorting by size instead. Maybe I can sort
- of punt this by giving the option of new dump to show only matching elements.
- Maybe I should watch SetHandleSize/PtrSize too, so that the display shows the current
- block size, instead. If it is a real leak, it should be the same size later too.
- Should be some way to watch for MoreMasters leaks too.
- *)
-
- {$R-}
- {$D+} { debug labels on. }
-
- INTERFACE
-
- USES MemTypes, Resources, Traps, Memory, OSUtils, Events,
- dcmd; { Macsbug interface routines. }
-
-
- CONST
- kOnlyList = 1; { 'Leaks' }
- kTurnOn = 2; { 'Leaks On' }
- kTurnOffNList = 3; { 'Leaks Off' }
- kDumpAll = 4; { 'Leaks Dump' }
-
- kMaxTrackingTableEntries = 500; { Kinda hard coded, better way? For # of blocks to watch. }
-
- kHexDigits = '0123456789ABCDEF'; { Digits in base 16, for hex conversion. }
-
- kCrawlArraySize = 8; { Number of stack crawls to do. }
-
-
- TYPE
- StackArray = Array [1..kCrawlArraySize] of LongInt; { Number of stack crawls I do for a call. }
-
- TrackEntryPtr = ^TrackingTableEntry;
- TrackingTableEntry = RECORD
- address: LongInt; { a handle or a pointer, If in emptyQ it is a link. }
- lessThanLink: TrackEntryPtr; { queue link to tree whose 'address' is less than this one }
- greaterThanLink: TrackEntryPtr; { queue link of tree with 'address' bigger than this one. }
- blockSize: LongInt; { Size of block being tracked. }
- pcStack: StackArray; { stack crawl worth of pcs. }
- tickTime: LongInt; { tickCount when allocated. }
- END; { The size is multiplied by 500 to give the size of a block in system heap. }
-
- TreeInfo = RECORD { This is the header for the b-trees, used for status info. }
- treeTop: TrackEntryPtr;
- treeCount: Integer;
- emptyQ: TrackEntryPtr;
- emptyCount: Integer;
- trackActive: Boolean;
- END;
-
- { When I'm analyzing the tree for likely leaks, I save off the candidates in an array. }
- TrackTableArray = RECORD
- leakCount: Integer;
- leakEntries: Array [1..10] of TrackingTableEntry;
- leakMatchCount: Array [1..10] of Integer;
- END;
-
- { When I pass back hex numbers on the stack, I want to use small ones. }
- Str8 = String[8];
-
- PROCEDURE CreateLeakWatcher;
-
- { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. }
- PROCEDURE CommandEntry (paramPtr: dcmdBlockPtr);
-
- { Routine to put another element on b-tree to watch a memory manager address. }
- PROCEDURE AddNewBlock (addressToAdd, sizeToAdd: LongInt; stackToAdd: StackArray;
- VAR treeTop, emptyQ: TrackEntryPtr);
-
- { Routine to forget about a b-tree element watching an address. }
- PROCEDURE KillOldBlock (addressToKill: LongInt; VAR treeTop, emptyQ: TrackEntryPtr);
-
-
- IMPLEMENTATION
-
-
- { These globals are used so that I can limit the stack usage during recursion. They don't
- really have to be globals, but it is a convenience. I label them with a p, so that you can
- immediately see they are private globals (to this unit), a quality MacApp convention. }
- VAR pDumpString: Str255; { To dump label info, from symbols in code. }
- pLeakRecord: TrackTableArray; { Array of likely leaks, to be dumped. }
- pCountEm: Integer; { number of exact matches during analysis. }
- pTreeInfo: TreeInfo; { common tree header from Chain result. }
- pOptionToDo: Integer; { global decisions based on command line parameters. }
- pCheckElement: TrackEntryPtr; { during analysis, to avoid it on stack. }
- pBuffer: Ptr; { Address of buffer allocated in system heap. }
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
-
- { Set the address of NewPtr before I patch the trap. This is so the assembly interface can
- find this address again, when it is called as part of a NewPtr trap. This is required because
- I really need PC-relative addressing in order to be able to get this old address. All four
- of the routines I patch have the same problem, so I have an interface for each. The
- asm routine just saves off the address passed in, as a PC-Relative variable. That way
- when the patch code actually executes it can find the header of the b-tree in order to
- add things to it. }
- PROCEDURE SetOldNewPtr (address: LongInt); EXTERNAL;
- PROCEDURE SetOldNewHandle (address: LongInt); EXTERNAL;
- PROCEDURE SetOldDisposPtr (address: LongInt); EXTERNAL;
- PROCEDURE SetOldDisposHandle (address: LongInt); EXTERNAL;
-
-
- { The references to the asm routines. }
- PROCEDURE WatchNewPtr; EXTERNAL;
- PROCEDURE WatchDisposPtr; EXTERNAL;
- PROCEDURE WatchNewHandle; EXTERNAL;
- PROCEDURE WatchDisposHandle; EXTERNAL;
-
-
- { When I want to get the TreeInfo, I must get it from the asm side of the world. It
- has saved the addresses in a PC-Relative way, since it needs them whenever the
- trap patches get called. This is the interface to get that info. }
- FUNCTION GetTreeTop: TrackEntryPtr; EXTERNAL;
- FUNCTION GetEmptyQ: TrackEntryPtr; EXTERNAL;
- FUNCTION TrackActive: Boolean; EXTERNAL;
-
- { When I start up this leak testing universe, I have to set the variables used by the
- assembly patch code. The tree will be allocated and initialized by this dcmd code,
- and then used by the patch code. }
- PROCEDURE SetTreeTop (address: TrackEntryPtr); EXTERNAL;
- PROCEDURE SetEmptyQ (address: TrackEntryPtr); EXTERNAL;
- PROCEDURE SetActive (state: Boolean); EXTERNAL;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Another handy routine stolen from MacApp to do the conversion on the dang strings. I
- only pass back Str8, since that is the maximum length, and stack space is limited in
- Macsbug, and I don't want to waste it needlessly.
- Notably, this one handles negative LongInts properly, unlike the one distributed with
- the dcmd samples. }
- FUNCTION NumberToHex(decNumber: UNIV LongInt): Str8;
-
- VAR i: Integer;
- hexNumber: Str8;
-
- BEGIN
- hexNumber[0] := CHR(8);
- FOR i := 8 DOWNTO 1 DO
- BEGIN
- hexNumber[i] := kHexDigits[BAND(decNumber, 15) + 1];
- decNumber := BSR(decNumber, 4);
- END;
- NumberToHex := hexNumber;
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Zero a TrackingTableEntry, by clearing each field in the record. This is just a
- little utility routine. It is used during Init, and when a block is Killed. I clear the block
- just to be robust, even though it shouldn't matter what is in the block. If speed were
- an issue (it isn't) then I would skip this clearing, and just hit the fields that really
- matter, like address. It makes it easier to see what's going on when debugging it,
- and it helps to prevent inadvertent bugs from blowing it up. Yes, this type of stuff
- can mask some bugs, but it is more important that it run properly. }
- PROCEDURE ZeroTrackEntry (VAR theEntry: TrackEntryPtr);
-
- VAR I: Integer;
-
- BEGIN
- WITH theEntry^ DO BEGIN
- address := 0;
- lessThanLink := NIL;
- greaterThanLink := NIL;
- blockSize := 0;
- FOR I := 1 to kCrawlArraySize DO
- pcStack[I] := 0;
- tickTime := 0;
- END; { With toBeEmptied^ }
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Drive the entire buffer as a series of TrackingTableEntries, clearing each field in the
- records, and setting up the empty links between records. This is a brute force way to
- clean them out, but this is a robust way to do it. It presumes nothing about the buffer,
- except that it has been allocated. For instance, it doesn't rely on the record structure
- being valid. It could be blown up because of a bug here, but this will fix it. This is
- robustness. Sure, sure, it should never get blown up, but why not be robust instead
- of assuming things will always work properly? Now set up all the links from one
- 'address' to another, to make a linked list of empty q elements. I'm skipping the last
- entry in the queue (the -1), leaving it NIL to mark the end of the list.}
- PROCEDURE InitQ (buffer: Ptr);
-
- VAR thisEntry: TrackEntryPtr;
- I: Integer;
-
- BEGIN
- thisEntry := TrackEntryPtr(buffer);
- FOR I := 1 to kMaxTrackingTableEntries-1 DO BEGIN
- ZeroTrackEntry (thisEntry);
- thisEntry^.address := ORD(thisEntry) + SIZEOF (TrackingTableEntry);
- thisEntry := TrackEntryPtr(thisEntry^.address);
- END;
- ZeroTrackEntry (thisEntry); { zero the last entry too. }
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Check a sub tree recursively to be sure it is valid.
- ; This routine will drive the entire b-tree in memory, making sure that
- ; it is consistent. If it finds a problem there is a problem with the b-tree code, and
- ; thus this will break into the debugger.
- ; It will check to be sure that all of the elements in the tree are set up properly, like
- ; having the less than side have an address less than the owning element, and the
- ; same on the greater than side. This will ensure the tree will not have elements
- ; out of place. It will check the empty-q to be sure that it is still valid, and that
- ; all of the elements are empty. While doing these checks it will count the
- ; number of elements in each queue, making sure that I haven't lost any
- ; elements. }
-
- PROCEDURE CheckSubTree (treeElement: TrackEntryPtr; VAR bElementCount: Integer);
-
- BEGIN
- { If I have a non-empty less than node, check it out. }
- IF treeElement^.lessThanLink <> NIL THEN BEGIN
-
- { I have another sub-tree, check that element with respect to this one,
- and if not valid, blow into debugger. }
- IF treeElement^.address <= treeElement^.lessThanLink^.address THEN
- (* DebugStr ('b-tree is fried. lessThanLink is wrong.'); *)
- dcmdDrawLine (ConCat('b-tree is fried. lessThanLink is wrong. ',
- NumberToHex (treeElement^.address)));
-
- { I have a cool link on the less than side. Go ahead and recursively check
- the subtree on that side. }
- CheckSubTree (treeElement^.lessThanLink, bElementCount);
- END;
-
- { Check the greater than side too, to ensure it is valid. }
- IF treeElement^.greaterThanLink <> NIL THEN BEGIN
-
- { I have another sub-tree, check that element with respect to this one,
- and if not valid, blow into debugger. }
- IF treeElement^.address >= treeElement^.greaterThanLink^.address Then
- (* DebugStr ('b-tree is fried. greaterThanLink is wrong.'); *)
- dcmdDrawLine (ConCat('b-tree is fried. greaterThanLink is wrong. ',
- NumberToHex (treeElement^.address)));
-
-
- { I have a cool link on the greater than side. Go ahead and recursively check
- the subtree on that side. }
- CheckSubTree (treeElement^.greaterThanLink, bElementCount);
- END;
-
- { I've checked both sides of this element and it is valid. Count this as
- a valid element, then fall out of this level of recursion. }
- bElementCount := bElementCount + 1;
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { The outside level to check the b-tree and empty queue for validity. This will
- call the recursive routine to check the b-trees, counting elements as it goes.
- The three queues are passed in, to simplify finding them. }
-
- FUNCTION CheckQs (treeTop, emptyQ: TrackEntryPtr;
- maxElements: Integer; active: Boolean): TreeInfo;
-
- VAR bElementCount: Integer;
- qWalk: TrackEntryPtr;
- tempInfo: TreeInfo;
-
- BEGIN
- { Copy the heads of the queues off, so I can return them later. The count
- of elements will be set as I count them. }
- tempInfo.treeTop := treeTop;
- tempInfo.emptyQ := emptyQ;
- tempInfo.trackActive := active;
-
- bElementCount := 0; { Start element count at zero. }
-
- { Drive the b-tree queue to be sure it is valid. Start at the top of the tree,
- unless there are no elements. }
- IF treeTop <> NIL THEN CheckSubTree (treeTop, bElementCount);
- tempInfo.treeCount := bElementCount;
-
- { If I lived through that, both b-trees are valid. Now check the empty
- list to be sure that all the links are still valid there. As long as the
- empty Q is not completely used up, start at the top and drive each link. }
- qWalk := emptyQ;
-
- IF emptyQ <> NIL THEN
- REPEAT
- IF qWalk^.lessThanLink <> NIL THEN
- (* DebugStr ('empty queue list is fried. lessThanLink non-NIL'); *)
- dcmdDrawLine (ConCat('empty queue list is fried. lessThanLink non-NIL-- ',
- NumberToHex (qWalk^.lessThanLink)));
- IF qWalk^.greaterThanLink <> NIL THEN
- (* DebugStr ('empty queue list is fried. greaterThanLink non-NIL'); *)
- dcmdDrawLine (ConCat('empty queue list is fried. greaterThanLink non-NIL-- ',
- NumberToHex (qWalk^.greaterThanLink)));
-
- bElementCount := bElementCount + 1;
- qWalk := TrackEntryPtr(qWalk^.address);
- UNTIL qWalk = NIL;
-
- { How ever many I saw there as free needs to be passed back. }
- tempInfo.emptyCount := bElementCount - tempInfo.treeCount;
-
-
- { I've driven the entire list of queue element in the world. Now if the
- count of elements doesn't jive with what I started, then barf, assuming
- some of them got lost. }
- IF bElementCount < maxElements THEN
- (* DebugStr ('count of elements is off. lost some'); *)
- dcmdDrawLine (ConCat('count of elements is off. lost some- ',
- NumberToHex (bElementCount)));
- IF bElementCount > maxElements THEN
- (* DebugStr ('count of elements is off. gained some!'); *)
- dcmdDrawLine (ConCat('count of elements is off. gained some! ',
- NumberToHex (bElementCount)));
-
- { Return the TreeInfo record that gives pertinent tidbits about this system. }
- CheckQs := tempInfo;
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { ; AddNewBlock will take an address on input, and add it to the b-tree. It does this
- ; by taking an element off of the empty queue list, filling in the fields for the element,
- ; then adding it to the b-tree list, by comparing the 'address' fields, to find where it
- ; fits in the hierarchy. On entry, addressToAdd is the address of the block to track.
- ; This is an address in the heap, pointing to the master pointer, or the block itself.
-
- The stackToAdd is an array of kCrawlArraySize elements that have the return addresses from the stack
- crawl if they were valid. These were validated before coming here, and if they weren't
- valid, they are nil to mark them as unused.
-
- Both the treeTop and top of the empties list will be modified by this routine, since
- it swaps an element out of the empty list into the b-tree as in use. }
-
- PROCEDURE AddNewBlock (addressToAdd, sizeToAdd: LongInt; stackToAdd: StackArray;
- VAR treeTop, emptyQ: TrackEntryPtr);
-
- VAR searchElement: TrackEntryPtr; { scratch element pointer. }
- ownerElement: TrackEntryPtr; { owner of searchElement. }
- freshElement: TrackEntryPtr; { fresh from empties list. }
- I: Integer;
-
- BEGIN
- { Check to see if I have used all the free elements up. *** perhaps I should just
- turn the tree off, as an assumption that they left it on accidentally? This is one
- DebugStr I don't change, since this will run at normal time, not in Macsbug. }
- freshElement := emptyQ;
- IF freshElement = NIL THEN BEGIN
- DebugStr ('Barf, no more empty queue elements!-LeakWatching...');
- Exit (AddNewBlock);
- END;
-
- { Pull top element off the empties list, and relink that list so that the next
- element in line is up for use. }
- emptyQ := TrackEntryPtr(freshElement^.address);
-
- { This will be a leaf node, clear the links. Set up the address to watch. }
- WITH freshElement^ DO BEGIN
- lessThanLink := NIL;
- greaterThanLink := NIL;
- address := addressToAdd;
- blockSize := sizeToAdd;
- tickTime := TickCount;
-
- FOR I := 1 to kCrawlArraySize DO
- pcStack[I] := stackToAdd[I];
- END; { With freshElement }
-
- { Now drive the b-tree to find the location to add the block at. The tree may
- be empty, so check that first. }
- searchElement := treeTop;
- IF searchElement = NIL THEN
- treeTop := freshElement { New top of tree. }
- ELSE BEGIN
- { Loop through the b-tree to find the location that this block should be
- added at. This will be a node which is NIL, which I can fill in
- with the freshElement. }
- REPEAT
- ownerElement := searchElement; { moved to a new non-nil one. }
- IF addressToAdd < searchElement^.address THEN
- searchElement := searchElement^.lessThanLink
- ELSE
- searchElement := searchElement^.greaterThanLink
- UNTIL searchElement = NIL;
-
- { Now add this fresh dude to the b-tree list. }
- IF freshElement^.address < ownerElement^.address THEN
- ownerElement^.lessThanLink := freshElement
- ELSE
- ownerElement^.greaterThanLink := freshElement
- END; { Else. not new top of tree. }
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Tree deletion. This is the main reason to use Pascal instead of assembly. This
- routine is much easier to understand in high level.
-
- ; KillOldBlock is the routine to have us forget about a block that I had previously
- ; been watching. When a block is disposed out of the heap, I have to forget about
- ; it, since I only want to keep track of things that are currently in use by the system.
- ; On entry to Kill, I have addressToKill as the address of the block to be removed from
- ; the b-tree based list. I will use that address to drive the tree looking for the b-tree
- ; element that is tracking that block in the heap. If I cannot find it, I let it go,
- ; presuming it was allocated before I was watching the blocks.
-
- The treeTop and emptyQ are VAR so that they can be changed if necessary to
- handle the emptying of either queue.
-
- This was adapted from an algorithm in Sedgewick. I tried to follow his code for
- the most part, to minimize changes that might introduce bugs. Here is his code,
- copied out straight, if it helps (my comments):
-
- ; This is relatively hairy, so just to help, here is the code from Sedgewick that
- ; demonstrates the remove of an element in pascal. t is the element to kill,
- ; x is the head of the tree.
- ; procedure treeDelete (t, x: Link);
- ; var p, c : Link;
- ; begin
- ; repeat
- ; p := x;
- ; if t^.key < x^.key then x := x^.l else x := x^.r;
- ; until x = t;
- ; if t^.r = z then x := x^.l
- ; else if t^.r^.l = z then
- ; begin x := x^.r; x^.l := t^.l; end
- ; else
- ; begin
- ; c := x^.r; while c^.l^.l <> z do c := c^.l;
- ; x := c^.l; c^.l := x^.r;
- ; x^.l := t^.l; x^.r := t^.r;
- ; end;
- ; if t^.key < p^.key then p^.l := x else p^.r := x;
- ; end;
- ;
- ; Thank Sedgewick for the lame variable names.
- }
-
- PROCEDURE KillOldBlock (addressToKill: LongInt; VAR treeTop, emptyQ: TrackEntryPtr);
-
- VAR ownerElement: TrackEntryPtr; { The owner of the element to be killed. }
- searchElement: TrackEntryPtr; { Used as a scratch element pointer. }
- toBeEmptied: TrackEntryPtr; { when adding back to empties list. }
- subTreeOwner: TrackEntryPtr; { to move a leaf node to replace killed. }
- I: Integer;
-
- BEGIN
- { Bail out of here if the tree is empty, nothing to remove. }
- IF treeTop = NIL THEN Exit(KillOldBlock);
-
- searchElement := treeTop;
- ownerElement := NIL;
-
- { Find the element that is tracking the addressToKill. }
- WHILE addressToKill <> searchElement^.address DO BEGIN
- ownerElement := searchElement; { New searcher, means new owner. }
- IF addressToKill < searchElement^.address THEN
- searchElement := searchElement^.lessThanLink
- ELSE
- searchElement := searchElement^.greaterThanLink;
-
- { If I didn't find it before running off the end of a leaf, bail out. }
- IF searchElement = NIL THEN Exit(KillOldBlock);
- END;
-
- {
- ; When I have found a b-tree element that has a matching 'address' field, I have
- ; found the element. Remove it from the tree and put it back into the free element
- ; list. This means getting out the book to see how this works. The basic idea is to
- ; look at both the lessThan and greaterThan links to see if they have they have any
- ; subtrees, and if not, just move them in, setting the links in the owner element. If
- ; both sides have subtrees, then I want to drive the lessThan side to find the element
- ; that is out at the end of that subtree, then I will move it up into the current location.
- ; This takes a leaf node, and moves it further up in the tree, but keeps the tree sorted
- ; by address the way I need it. For a complete discussion, see Sedgewick.
- ; When the block has been found the ownerElement will be set to the parent b-tree
- ; element used, and bTreeBlock will be the actual element that matches.
-
- Now the searchElement is the guy to be removed from the list. The
- ownerElement is the current owner of that element. }
-
- toBeEmptied := searchElement;
-
- { The first case is if the element being killed has no greaterThanLink. If not,
- I can just move the lessThanLink from the toBeEmptied into the
- ownerElement's lessThanLink. The idea is that if one side has no
- subTree, then I can just move the subtree into the old spot. }
- IF toBeEmptied^.greaterThanLink = NIL THEN
- searchElement := toBeEmptied^.lessThanLink { grab pointer to subtree. }
- ELSE
- { Second case is if the descendant of the greaterThanLink has an empty
- lessThanLink. This means I can just move the element up one by
- modifying it's greaterThanLink as well as the ownerElement's link. }
- IF toBeEmptied^.greaterThanLink^.lessThanLink = NIL THEN
- BEGIN
- searchElement := toBeEmptied^.greaterThanLink;
- searchElement^.lessThanLink := toBeEmptied^.lessThanLink;
- END
- ELSE
- { Otherwise I have the hardest case of having both subtrees in use.
- I need to drive down the subtree to the smallest node, and move
- that node up to the current position, to replace the toBeEmptied. }
- BEGIN
- subTreeOwner := toBeEmptied^.greaterThanLink;
- WHILE subTreeOwner^.lessThanLink^.lessThanLink <> NIL DO
- subTreeOwner := subTreeOwner^.lessThanLink;
- searchElement := subTreeOwner^.lessThanLink;
- subTreeOwner^.lessThanLink := searchElement^.greaterThanLink;
- searchElement^.lessThanLink := toBeEmptied^.lessThanLink;
- searchElement^.greaterThanLink := toBeEmptied^.greaterThanLink;
- END;
-
- { If the ownerElement is NIL, I am removing the top of the tree, so I have
- a new treetop. }
- IF ownerElement = NIL THEN
- treeTop := searchElement
- ELSE
- { Decide which side of the tree to add to. }
- IF toBeEmptied^.address < ownerElement^.address THEN
- ownerElement^.lessThanLink := searchElement
- ELSE
- ownerElement^.greaterThanLink := searchElement;
-
- { Now the element has been removed from the tree. Add it back into the
- empties list so it is available for use. This resets the top of the empties list. }
- ZeroTrackEntry (toBeEmptied);
-
- toBeEmptied^.address := ORD4(emptyQ);
- emptyQ := toBeEmptied;
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { This is an init routine that sets up the trap patches, and creates and inits the block in
- the system heap that is used to store the records that track each block I see go by. This
- is a hard-coded tracking size, which is bad. This part uses the toolbox, which is a bad
- idea for dcmds to do. If I can't get space for the buffer, I won't install the patches,
- and I'll beep to let them know. Just added the dcmdSwapWorlds to make it work
- with TMon Pro. }
- PROCEDURE CreateLeakWatcher;
-
- VAR bigBuff: LongInt;
-
- BEGIN
- { Before I watch anything, the tree must be empty, and turned off by default. }
- SetTreeTop (NIL);
- SetActive (FALSE);
-
- { I need to create the big buffer that holds all the elements, but they initially will
- all be zeroed, and chained together into the emptyQ list. If I can't get it, beep. I
- do this funky ord4 stuff so it is LongInt math for big buffer sizes. }
- bigBuff := ORD4(kMaxTrackingTableEntries) * ORD4(SIZEOF(TrackingTableEntry));
- pBuffer := NewPtrSys (bigBuff);
- IF pBuffer = NIL THEN BEGIN
- SysBeep (5);
- Exit (CreateLeakWatcher); { Skip out, avoiding trap patches. }
- END;
-
- { Got the dang buffer. Clear every record in the buffer, and reset all the linked list
- address pointers. The tree will thus be empty, and the emptyQ will have all the
- records. }
- InitQ (pBuffer);
-
- { The queue is set up as a linked list of empty elements. Tell the asm side where it starts. }
- SetEmptyQ (TrackEntryPtr(pBuffer));
-
- { Patch the traps.... These are being patched in the world, not in the debugger world. }
- { Switch over to the real world, in case the debugger does world swaps. TMon Pro.}
- dcmdSwapWorlds;
-
- { Use NGetTrapAddress since it is always safer on current machines. Take the result
- it gives me, and save it off in asm land, for future reference. Then, move in the
- new address of the routine, my asm glue, with watching junk. }
- SetOldNewPtr (NGetTrapAddress(_NewPtr, OSTrap));
- NSetTrapAddress(ORD(@WatchNewPtr), _NewPtr, OSTrap);
-
- { Do DisposPtr }
- SetOldDisposPtr (NGetTrapAddress(_DisposPtr, OSTrap));
- NSetTrapAddress(ORD(@WatchDisposPtr), _DisposPtr, OSTrap);
-
- { Do the obvious NewHandle dude too. }
- SetOldNewHandle(NGetTrapAddress(_NewHandle, OSTrap));
- NSetTrapAddress(ORD(@WatchNewHandle), _NewHandle, OSTrap);
-
- { Do DisposHandle, too. }
- SetOldDisposHandle (NGetTrapAddress(_DisposHandle, OSTrap));
- NSetTrapAddress(ORD(@WatchDisposHandle), _DisposHandle, OSTrap);
-
- { Switch back to debugger world. }
- (* dcmdSwapWorlds; *)
- END; { CreateLeakWatcher }
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Just a handy place to dump out the info about an element. This has been changed to dump using the
- Macsbug call backs instead, and to use the NumberToHex routine for the numbers. Do a stack crawl, using
- the address given, trying to see if there is a symbol associated. I dump them out from the highest to lowest
- to match the StackCrawl that Macsbug uses. Also, since some are set to Nil when the stack crawler doesn't
- have a valid address, I look for that, and skip the dump if the pc address was not valid.
- I added the matchCount to give the info about the number of blocks that match this one, but have
- a different address. }
- PROCEDURE PrintElement (element: TrackEntryPtr; matchCount: Integer);
-
- VAR I: Integer;
-
- BEGIN
- WITH element^ DO
- BEGIN
- dcmdDrawLine(ConCat('address: ', NumberToHex(address), ' size: ', NumberToHex(blockSize),
- ' time: ', NumberToHex(tickTime), ' matches: ', NumberToHex(matchCount)));
- FOR I := kCrawlArraySize DownTo 1 DO
- IF pcStack[I] <> 0 THEN BEGIN
- dcmdGetNameAndOffset (pcStack[I], pDumpString);
- dcmdDrawLine(ConCat(' ', NumberToHex(pcStack[I]), ': ', pDumpString));
- END;
- END;
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { A more rough printout of the elements, that is used for the dump operation. The stack crawl
- during a full dump seemed a bit much, so this gives you the numbers, but without symbols.
- The most interesting info is the block address, so I do that for each block, of course. }
- PROCEDURE PrintRaw (element: TrackEntryPtr);
-
- BEGIN
- WITH element^ DO
- BEGIN
- dcmdDrawLine(ConCat('address: ', NumberToHex(address), ' size: ', NumberToHex(blockSize), ' time: ', NumberToHex(tickTime)));
- dcmdDrawLine(ConCat(' pc1: ', NumberToHex(pcStack[1]), ' pc2: ', NumberToHex(pcStack[2]), ' pc3: ', NumberToHex(pcStack[3]), ' pc4: ', NumberToHex(pcStack[4])));
- dcmdDrawLine(ConCat(' pc5: ', NumberToHex(pcStack[5]), ' pc6: ', NumberToHex(pcStack[6]), ' pc7: ', NumberToHex(pcStack[7]), ' pc8: ', NumberToHex(pcStack[8])));
- END;
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Recursively dump the tree from the lowest address on up. Since I'm dumping the entire
- tree, and not just likely leaks, I'll dump it out in a more raw format, without doing
- the stack crawl via labels. This is to take up less space visually in the scrolling area. I
- don't really expect anyone to use this option that much, although it does give you the
- addresses of all the blocks currently being tracked. }
- PROCEDURE DumpTree (element: TrackEntryPtr);
-
- BEGIN
- IF element^.lessThanLink <> NIL THEN
- DumpTree(element^.lessThanLink);
-
- PrintRaw(element); { do it after driving smallest links. }
-
- IF element^.greaterThanLink <> NIL THEN
- DumpTree(element^.greaterThanLink);
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Minor routine to see if the two elements actually match in size as well as all the stack crawl
- entries in each element. Don't care about Time, and certainly not the address.
- I do the size first, since it is most likely to not match, then backwards through the
- crawl, since the topmost number is most likely not to match. (a minor optimization) }
- FUNCTION ElementMatch (el1, el2: TrackEntryPtr): Boolean;
-
- VAR I: Integer;
-
- BEGIN
- ElementMatch := FALSE; { Assume they don't match, so I can jump out. }
-
- IF el1^.blockSize <> el2^.blockSize THEN Exit (ElementMatch);
- FOR I := kCrawlArraySize DownTo 1 DO
- IF el1^.pcStack[I] <> el2^.pcStack[I] THEN Exit (ElementMatch);
-
- ElementMatch := TRUE; { Made it through, must match. }
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Add an element to the array of known duplicates. If it already exists in the array,
- skip it. If I already have 10 elements in the array, skip it, since this is leak city.
- Once they fix a few leaks, then try again, you'll see more. I limit it to 10 since
- Macsbug has a limited stack, and don't want to burn up too much for elements
- I may never use. All this code is recursive, so I gotta keep the stack small
- as I can.
- By checking for an exact match here, I can avoid adding extra elements to the
- list, and using this list I can just dump these elements, giving the stack crawl
- of a single block, rather than each one that matches. The user thus just sees
- a single leaking stack crawl, with one of the blocks. If they want to see all
- the blocks, they can do a dump array command instead.
- As part of the adding, I'm adding the pCountEm so I can dump that tidbit of info
- along with the elements. This is the number of entries in the b-tree that match
- this element, which is >= 3, and the actual number may be helpful. If you want
- to see all the blocks, do a dump instead, and look for the size manually. }
- PROCEDURE AddToArray (elementToAdd: TrackEntryPtr);
-
- VAR I: Integer;
-
- BEGIN
- WITH pLeakRecord DO BEGIN
- IF leakCount = 10 THEN
- Exit (AddToArray); { If I'm full up, skip it. }
-
- FOR I := 1 TO leakCount DO
- IF ElementMatch (elementToAdd, @leakEntries[I]) THEN
- Exit (AddToArray); { once it's been found, no need to scan them all. }
-
- { No matching element in the leakEntries array yet, so go ahead and add it. (copy all fields over) }
- leakCount := leakCount + 1;
- leakEntries[leakCount] := elementToAdd^;
- leakMatchCount[leakCount] := pCountEm; { number of matching elements in tree. }
- END; { With leakRecord }
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Given an element to examine, drive the tree looking for other blocks that match.
- I drive the whole tree now, but it should be reasonable to skip out after pCountEm goes over
- 3, since it is likely to be a leak for the current element. This would complicate a recursive
- routine, which goes against my grain. The pCountEm parameter is passed as a global, so
- I don't have to burn up stack for it. Since this is the second loop of a doubly nested
- recursive treewalk, I use the pCheckElement as the current element being examined
- from the outer loop. It changes for each iteration of the outside loop, while I drive
- the entire tree again in this loop. This use of a global is a little sick, but allows me to
- trim the amount of stuff on the stack as I scan for matching elements.
-
- I've also added a sick check to see if the element^.address is a resource handle or not.
- If it is, this element cannot be a leak yet, since it is being used by the resource manager.
- I was seeing a number of blocks go by that were resource handles, that happened to have
- the same size, and the same stack crawl. They aren't leaks, so this change is to get rid
- of those false alarms. I check to see if the element itself is a match first, as a minor
- optimization to avoid a lot of resource map driving. The short circuit & will bail
- if it's not a match. Notably this is using the Resource Manager at interrupt time.
- The user might very well have dropped into Macsbug at a strange place. This is
- probably not a big deal, since all it has to do is drive a block in the heap, looking
- through the resource map for a match. I don't want to do that same driving, since
- any code here would have the same problems as RsrcMapEntry. If you ever see
- any problems with this, I would be very interested to know.
- The RsrcMapEntry will return -1 if it doesn't find one, not zero as documented. }
- PROCEDURE CountMatchingSize (element: TrackEntryPtr);
-
- BEGIN
- IF ElementMatch(element, pCheckElement) & (RsrcMapEntry(Handle(element^.address)) = -1) THEN
- pCountEm := pCountEm + 1; { Up the count before recursing. }
-
- IF element^.lessThanLink <> NIL THEN { If I have a link, go there too. }
- CountMatchingSize(element^.lessThanLink);
- IF element^.greaterThanLink <> NIL THEN { Recursively drive the right link too. }
- CountMatchingSize(element^.greaterThanLink);
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { This guy will drive the entire tree in memory, and for each element, it
- will do the CountMatchingSize procedure. If enough are found (>=3) then I'll
- print one out later. If they aren't found, then I just go on to the next element and
- see if any others in the tree match it. This is thus a two level recursive system to
- find any blocks that have the same size. You can think of it as being two nested loops,
- the outside driving each element of the tree, and the inside one driving each element
- in the tree, too. Any elements that appear multiple times (size, stack crawl match)
- I'll add to the array of leaks for later display. This guy gets passed the treetop to
- start it up. Careful of the stack usage here, I'm pushing 4 bytes for each recursive
- call here, and 4 bytes for each recursive call of CountMatchingSize. For a typical b-Tree
- this won't be a problem, since it will only be 10 or so levels at the deepest. Macsbug
- has a gutless 1K stack though, so it is risky business. }
- PROCEDURE DriveTreeForMatch (element: TrackEntryPtr);
-
- BEGIN
- pCountEm := 0;
-
- { Start at the treetop again, and see how many match. Set the global pCheckElement to
- be the current element, since it won't change over the entire invocation of the
- CountMatchingSize. }
- pCheckElement := element;
- CountMatchingSize(pTreeInfo.treeTop);
-
- { If this element is duplicated 3 or more times, save it off in the pLeakRecord. }
- IF pCountEm >= 3 THEN AddToArray(element);
-
- { Now I'm done with that element, recursively drive each element in the tree
- that was passed in; and thus I'll drive any subtrees. }
- IF element^.lessThanLink <> NIL THEN { If I have a link, go there too. }
- DriveTreeForMatch(element^.lessThanLink);
- IF element^.greaterThanLink <> NIL THEN { Recursively drive the right link too. }
- DriveTreeForMatch(element^.greaterThanLink);
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Drive the tree trying to find the likely candidate for a leak.
- Now the tree is available, drive the tree looking for duplicate blocks. This is rather
- loose, and a duplicate is considered to be repeated 3 or more times as having the same
- size and stack crawl. The operation is presumed to have been run 3 or more times, to
- duplicate a leaked block 3 or more times. I use the global variable pTreeInfo in order
- to find the top of the b-tree for analysis. The pLeakRecord is used to keep track of likely
- leaks, and is global too. (These are globals to avoid some stack usage, not because I
- think globals are a hot idea. With a 1K stack in Macsbug, and recursive routines, I'm
- going to extremes.) }
- PROCEDURE AnalyzeTree;
-
- VAR I: Integer;
-
- BEGIN
- pLeakRecord.leakCount := 0;
-
- { If the tree is non-empty, drive every element in it, trying to find other elements
- that have the same info (blockSize, stackCrawl). I pass treeTop from the global here,
- but it has to be stack based for the recursive use above. }
- IF pTreeInfo.treeTop <> NIL THEN DriveTreeForMatch(pTreeInfo.treeTop);
-
- { For every block in the seen list, dump it out as the cool info they need to know. This
- list has no duplicates, so they only get one leak for each element dumped. If there were
- no leaks, the leakCount is zero, and I don't do this loop at all. }
- FOR I := 1 TO pLeakRecord.leakCount DO
- BEGIN
- dcmdScroll; { Put in blank line. }
- PrintElement(@pLeakRecord.leakEntries[I], pLeakRecord.leakMatchCount[I]);
- END;
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Dump out the tree info, like the number of elements in use. This is sort of marginally useful,
- since you can see how many block are being tracked currently; but the main reason to show it
- is to give the calling human feedback that something actually happened. In a case where there
- were no leaks, this is all you would see (which is preferable to not showing anything). I also
- use the global pTreeInfo, to be consistent with the other routines, even though the stack
- usage isn't really a concern for this routine. }
- PROCEDURE DumpHeaders;
-
- BEGIN
- WITH pTreeInfo DO
- BEGIN
- IF pTreeInfo.trackActive THEN dcmdDrawLine ('ON: ')
- ELSE dcmdDrawLine ('OFF: ');
-
- { Write out: ' top of tree: 00042133 with 00000500 elements.' }
- dcmdDrawString (ConCat (' top of tree:', NumberToHex (ORD(treeTop)), ' with ', NumberToHex (treeCount), ' elements.'));
-
- { Write out: ' empty list: 00042133 with 00000500 elements.' }
- dcmdDrawLine (ConCat (' empty list:', NumberToHex (ORD(emptyQ)), ' with ', NumberToHex (emptyCount), ' elements.'));
- END;
- END;
-
-
- { Get the TreeInfo, and check the b-tree for consistency. *** make it pointer. }
- FUNCTION GetTreeInfo: TreeInfo;
- BEGIN
- GetTreeInfo := CheckQs (GetTreeTop, GetEmptyQ, kMaxTrackingTableEntries, TrackActive);
- END;
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { The top of the dump info food chain. This guy will dump information out, after driving
- the tree numerous times. It will call the b-tree code via asm interface in order to get the magic
- info of the tree header, so I can drive the tree at will, looking for matching blocks, dumping
- each block to the output, and so on. Also, the magic interface is turned on or
- off, here. I've passed the pOptionToDo as a global here, going to extremes to avoid using
- more of the stack than needed. }
- PROCEDURE DumpLeakBlocks;
-
- BEGIN
- dcmdScroll; { bump up a line in the display. }
-
- { Now decide what to do, based on the optionToDo. }
- CASE pOptionToDo OF
-
- kOnlyList: { 'Leaks' }
- BEGIN
- pTreeInfo := GetTreeInfo;
- DumpHeaders;
- AnalyzeTree;
- END;
-
- kTurnOn: { 'Leaks On' }
- BEGIN
- SetActive (TRUE);
- InitQ (pBuffer); { Clear the buffer, reset the tree and emptyQ. }
- SetEmptyQ (TrackEntryPtr(pBuffer));
- SetTreeTop (NIL);
- pTreeInfo := GetTreeInfo;
- DumpHeaders;
- END;
-
- kTurnOffNList: { 'Leaks Off' }
- BEGIN
- SetActive (FALSE);
- pTreeInfo := GetTreeInfo;
- DumpHeaders;
- AnalyzeTree;
- END;
-
- kDumpAll: { 'Leaks Dump' }
- BEGIN
- pTreeInfo := GetTreeInfo;
- DumpHeaders;
- IF pTreeInfo.treeTop <> NIL THEN DumpTree(pTreeInfo.treeTop);
- END;
-
- OTHERWISE dcmdDrawLine (' Syntax Error');
- END; { Case pOptionToDo }
-
- END; { DumpLeakBlocks }
-
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- { Well, I stole this routine from MacApp utilities. I want to lower case the strings so I
- don't have case sensitivities. This will do it, without using the toolbox. }
- PROCEDURE LowerStr255(VAR s: Str255);
-
- VAR i: INTEGER;
-
- BEGIN
- FOR i := 1 TO LENGTH(s) DO
- IF (s[i] IN ['A'..'Z']) THEN
- s[i] := CHR(Ord(s[i]) + 32)
- END; { LowerStr255 }
-
-
- {---------------------------------------------------------------------------------------------------------------------------------}
- {---------------------------------------------------------------------------------------------------------------------------------}
-
- { This fine fellow is the main entry point for the dcmd. It is the hook by which I get called
- by MacsBug to do my thing. It is basically the chance to key off the command line and do
- what they request. I'm using pDumpString here, since it's temporarily used to build a
- pOptionToDo, and I don't want to waste stack space. It will be pounded by any of the
- dump routines, so realize this is sick, and dangerous. Also realize that a Str255 is
- one-fourth, countem, one-fourth of the entire Macsbug stack (1K). I can't afford to
- waste string space, that is clear.
-
- Change the version number in the help, whenever it is re-released. This is the only
- version number in the program. }
- PROCEDURE CommandEntry (paramPtr: DCmdBlockPtr);
-
- VAR ch: CHAR;
-
- BEGIN
- CASE paramPtr^.request OF
- { When I'm called to Init, do the init code of installing the trap patches, allocate data block. }
- dcmdInit:
- CreateLeakWatcher;
-
- { I can get various DoIt commands, so parse out the options. If I don't get anything,
- do the standard dump info. I lowercase the string so I can avoid any case sensitivity
- on options passed in. }
- dcmdDoIt:
- BEGIN
- ch := dcmdGetNextParameter (pDumpString);
- LowerStr255 (pDumpString);
- IF pDumpString = '' THEN pOptionToDo := kOnlyList
- ELSE IF pDumpString = 'dump' THEN pOptionToDo := kDumpAll
- ELSE IF pDumpString = 'on' THEN pOptionToDo := kTurnOn
- ELSE IF pDumpString = 'off' THEN pOptionToDo := kTurnOffNList
- ELSE pOptionToDo := -1;
-
- DumpLeakBlocks; { using pOptionToDo to decide. }
- END;
-
- { Give them the obvious help info. }
- dcmdHelp:
- BEGIN
- dcmdDrawLine ('Leaks [On|Off|Dump]');
- dcmdDrawLine (' Stack crawl info about likely memory leaks. (Version 5)');
- END;
- END; { End of case paramPtr^.request. }
-
- END; { CommandEntry }
-
- END.
-